perm filename SAY.SAI[8,ALS] blob
sn#044824 filedate 1973-05-30 generic text, type T, neo UTF8
00100 COMMENT ⊗ VALID 00002 PAGES
00200 RECORD PAGE DESCRIPTION
00300 00001 00001
00400 00002 00002 BEGIN "SAY"
00500 00007 ENDMK
00600 ⊗;
00100 BEGIN "SAY"
00200 DEFINE ⊂="COMMENT"; ⊂ 5/28/73 Runs SIG from FIX output;
00250 ⊂ This version smooths data using routine update after each ripple;
00300 REQUIRE "COMSUB.HDR[SYS,ALS]" SOURCE_FILE;
00400 REQUIRE "SAYSIG[8,ALS]" LOAD_MODULE;
00500 REQUIRE "BLOCKS.HDR[SYS,THO]" SOURCE_FILE;
00600 EXTERNAL FORTRAN PROCEDURE SIG(REFERENCE INTEGER P);
00700 INTEGER ARRAY LFILE[0:'177];
00800 INTERNAL INTEGER ARRAY INDATA[0:4000];
00900 INTERNAL INTEGER H,I,J,K,L,M,N,P,NF;
01000 INTERNAL INTEGER FLAG,TFLAG,UPCNT;
01100 INTERNAL INTEGER SEGC,INTOT,SEGTOT,HINT,BPT,INFLAG;
01200 INTEGER HINCNT,HCOUNT,HINDEX,EOF,EOFA,BRK;
01300 STRING PREHINT;
01400 INTEGER CHAN1,CHAN2,CHAN3,CHAN4,CHAN5;
01500 STRING READ1,FILEL,FILEI,TFILE,TFILEI,FILLST;
01600 LABEL START,ZZZZ,ZZZ,ZZ;
01602 DEFINE ⊂="COMMENT",CR="'15",LF="'12",TB="'11";
01604 DEFINE CRLF="CR&LF", CRLF0="CR&'177&'21"; ⊂ FOR CRLF W/O FORM FEED;
01606 BOOLEAN ER;
01608
01610 INTEGER EOFB,RL;
01612 INTERNAL INTEGER STX,STXX;
01614 STRING FILSTR,SNAMES,SNAME;
01616
01620 INTEGER RETAIN; STRING OPT2;
01622 PRELOAD_WITH
01624 '777777777760,
01626 '377775777760,
01628 '177774777760,
01630 '077774377760,
01632 '037774177760,
01634 '017774077760,
01636 '007774037760,
01638 '003774017760,
01640 '001774007760;
01642 INTEGER ARRAY MASKP[0:8];
01644 PRELOAD_WITH
01646 '777777777777,
01648 '377776000000,
01650 '177776000000,
01652 '077776000000,
01654 '037776000000,
01656 '017776000000,
01658 '007776000000,
01660 '003776000000,
01662 '001776000000;
01664 INTEGER ARRAY MASKQ1[0:8];
01666
01668 PRELOAD_WITH
01670 '777777777777,
01672 '377377377377,
01674 '177177177177,
01676 '077077077077,
01678 '037037037037,
01680 '017017017017,
01682 '007007007007,
01684 '003003003003,
01686 '001001001001;
01688 INTEGER ARRAY MASKQ2[0:8];
02049
02050 INTEGER PROCEDURE UPDATE;
02052 BEGIN "UPDATE"
02054
02056 COMMENT This procedure smooths the output values by adding data
02058 taken from adjacent entries. At the present the central location
02060 data is weighted 8 to 1 for the 4 nearest neighbors for
02062 P2 tables and 16 to 1 for the 6 nearest neighbors for P3
02064 tables. This routine works only for P tables;
02066
02068 INTEGER I,J,K,L,M,N,P,Q,R,Z;
02070 INTEGER GOOD,BAD,PLACE;
02072
02074
02076 FOR I←STXX+10 STEP 74 UNTIL STX-64 DO BEGIN
02078
02079 IF TABLES[I-9]=0 THEN DONE;
02080 PLACE←POINT(3,TABLES[I-9],5);
02082
02084 IF PLACE=2 THEN BEGIN
02086
02088 FOR J←0 STEP 1 UNTIL 7 DO
02090 FOR K←0 STEP 1 UNTIL 7 DO BEGIN
02092 N←J*8+K;
02094 GOOD←POINT(16,TABLES[I+N],31);
02096 L←LDB(GOOD);
02098 BAD←POINT(16,TABLES[I+N],15);
02100 Z←L+LDB(BAD);
02102
02104 L←L LSH 3; Z←Z LSH 3;
02106
02108 IF J>0 THEN BEGIN
02110 GOOD←POINT(16,TABLES[I+N-8],31); L←L+LDB(GOOD);
02112 BAD←POINT(16,TABLES[I+N-8],15); Z←Z+LDB(BAD)+LDB(GOOD); END;
02114
02116 IF J<7 THEN BEGIN
02118 GOOD←POINT(16,TABLES[I+N+8],31); L←L+LDB(GOOD);
02120 BAD←POINT(16,TABLES[I+N+8],15); Z←Z+LDB(BAD)+LDB(GOOD); END;
02122
02124 IF K>0 THEN BEGIN
02126 GOOD←POINT(16,TABLES[I+N-1],31); L←L+LDB(GOOD);
02128 BAD←POINT(16,TABLES[I+N-1],15); Z←Z+LDB(BAD)+LDB(GOOD); END;
02130
02132 IF K<7 THEN BEGIN
02134 GOOD←POINT(16,TABLES[I+N+1],31); L←L+LDB(GOOD);
02136 BAD←POINT(16,TABLES[I+N+1],15); Z←Z+LDB(BAD)+LDB(GOOD); END;
02138
02140 M←((L LSH 4)/Z+1)/2; IF M≥8 THEN M←7;
02142
02144 Q←POINT(32,TABLES[I+N],31);
02146 TABLES[I+N]←(LDB(Q) LSH 4)+M;
02148
02150 END;
02152
02154 END ELSE IF PLACE =3 THEN BEGIN
02156
02158 FOR J←0 STEP 1 UNTIL 3 DO
02160 FOR K←0 STEP 1 UNTIL 3 DO BEGIN
02162 R←J*4+K;
02164 FOR P←0 STEP 1 UNTIL 3 DO BEGIN
02166 N←R*4+P;
02168 GOOD←POINT(16,TABLES[I+N],31);
02170 L←LDB(GOOD);
02172 BAD←POINT(16,TABLES[I+N],15);
02174 Z←L+LDB(BAD);
02176
02178 L←L LSH 4; Z←Z LSH 4;
02180
02182 IF J>0 THEN BEGIN
02184 GOOD←POINT(16,TABLES[I+N-16],31); L←L+LDB(GOOD);
02186 BAD←POINT(16,TABLES[I+N-16],15); Z←Z+LDB(BAD)+LDB(GOOD); END;
02188
02190 IF J<3 THEN BEGIN
02192 GOOD←POINT(16,TABLES[I+N+16],31); L←L+LDB(GOOD);
02194 BAD←POINT(16,TABLES[I+N+16],15); Z←Z+LDB(BAD)+LDB(GOOD); END;
02196
02198 IF K>0 THEN BEGIN
02200 GOOD←POINT(16,TABLES[I+N-4],31); L←L+LDB(GOOD);
02202 BAD←POINT(16,TABLES[I+N-4],15); Z←Z+LDB(BAD)+LDB(GOOD); END;
02204
02206 IF K<3 THEN BEGIN
02208 GOOD←POINT(16,TABLES[I+N+4],31); L←L+LDB(GOOD);
02210 BAD←POINT(16,TABLES[I+N+4],15); Z←Z+LDB(BAD)+LDB(GOOD); END;
02212
02214 IF P>0 THEN BEGIN
02216 GOOD←POINT(16,TABLES[I+N-1],31); L←L+LDB(GOOD);
02218 BAD←POINT(16,TABLES[I+N-1],15); Z←Z+LDB(BAD)+LDB(GOOD); END;
02220
02222 IF P<3 THEN BEGIN
02224 GOOD←POINT(16,TABLES[I+N+1],31); L←L+LDB(GOOD);
02226 BAD←POINT(16,TABLES[I+N+1],15); Z←Z+LDB(BAD)+LDB(GOOD); END;
02228
02230 M←((L LSH 4)/Z+1)/2; IF M≥8 THEN M←7;
02232 Q←POINT(32,TABLES[I+N],31);
02234 TABLES[I+N]←(LDB(Q) LSH 4)+M;
02236
02238 END;
02240 END;
02242
02244 END;
02246
02248 END;
02250
02252 END "UPDATE";
02280
02290 STRING PROCEDURE HEADER;
02295 BEGIN "HEADER"
02300 STRING H1,H2; INTEGER I,J,K;
02305 IF HCOUNT>0 THEN BEGIN HCOUNT←HCOUNT-1; HINCNT←HINCNT+1; RETURN(PREHINT) END
02310 ELSE WHILE HCOUNT=0 DO BEGIN "XX"
02315 I←LFILE[HINDEX]; K←LDB(POINT(12,I,23)); J←SEGC-K;
02320 IF I=0 THEN BEGIN PREHINT←"NU"; HCOUNT←999; RETURN(PREHINT) END;
02325 IF J ≥ 0 THEN BEGIN "LATCH" H1←CVXSTR(LDB(POINT(12,I,11)) LSH 24);
02330 H2←CVXSTR(LDB(POINT(12,I,23)) LSH 24);
02335 IF EQU(H1,H2) THEN BEGIN
02340 OUTSTR(CRLF&"Old HEADER version, refuse to learn");
02345 HCOUNT←999; PREHINT←"NU"; RETURN("NU"); END;
02350
02355 IF H1≠0 THEN BEGIN
02360 PREHINT←H1; HCOUNT←LDB(POINT(12,I,35));
02365 HCOUNT←HCOUNT-J; HINDEX←HINDEX+1; HINCNT←HINCNT+1;
02370 RETURN(PREHINT); DONE END
02375 ELSE BEGIN PREHINT←"NU"; HCOUNT←LDB(POINT(12,I,35));
02380 HCOUNT←HCOUNT-J; HINDEX←HINDEX+1; RETURN(PREHINT); DONE; END;
02385 END "LATCH";
02390 PREHINT←"NU"; RETURN(PREHINT); END "XX";
02395 END "HEADER";
02495
03800 STDBRK(1);
03900 SETBREAK(14,"∃",NULL,"INS");
04000
04100 FILEL←"LIST1.L0";
04200 FILEI←"TOO1.DAT[1,THO]"; M←8; INFLAG←0;
04300 CHAN1←1; CHAN2←2; CHAN3←3; CHAN4←4; CHAN5←5;
04400 TABIN(INTOT);
04500
04510 RETAIN←4;
04514 IF(OPT2←STRIN("Retention is now at "&CVS(RETAIN)&" (CR or 0 to 9)="))≠"" THEN
04518 BEGIN RETAIN←CVD(OPT2); OUTSTR("Retention changed to "&CVS(RETAIN)&CRLF); END;
04522 IF RETAIN <9 THEN BEGIN K←-RETAIN;
04526 FOR I←10+INTOT*74 STEP 74 UNTIL TABSIZ-64 DO BEGIN
04530 IF TABLES[I-9]=0 THEN DONE;
04534 IF LDB(POINT(1,TABLES[I-9],5))=0 THEN
04538 FOR J←0 STEP 1 UNTIL 63 DO
04542 TABLES[J]←TABLES[J]-((TABLES[J] LSH K ) LAND MASKP[RETAIN]) ELSE
04546 FOR J←0 STEP 1 UNTIL 63 DO BEGIN
04550 TABLES[J]←TABLES[J]-((TABLES[J] LSH K ) LAND MASKQ1[RETAIN]);
04554 TABLES[J+74]←TABLES[J+74]-((TABLES[J+74] LSH K ) LAND MASKQ2[RETAIN]);
04558 I←I+74;
04562 END; END; END;
04570
05510 FILSTR←STRIN("Ripple learn break-point list (STFILE.TMP) =");
05520 IF FILSTR="" THEN FILSTR←"STFILE.TMP";
05530 CLOSE(CHAN5); OPEN(CHAN5,"DSK",1,2,0,3500,BRK,EOFB);
05540 LOOKUP(CHAN5,FILSTR,ER);
05550 WHILE ER DO BEGIN OUTSTR(CRLF&"Can not find "&FILSTR&
05560 " File = ");
05570 LOOKUP(CHAN5,FILSTR←INCHWL,ER); END;
05580 SNAMES←INPUT(CHAN5,14);
05590 SNAME←SCAN(SNAMES,1,J);
05595 IF SNAME="BEGIN" THEN STX←0 ELSE BEGIN
05600 FOR I←19 STEP 1 UNTIL 125 DO BEGIN
05610 IF LIST[I]=CVSIX(SNAME) THEN DONE;
05620 END;
05640 STX←I*74; END; EOFB←0;
05650
05660 FILEL←STRIN("Data file list (LNFILE.TMP) = ");
05670 IF FILEL="" THEN FILEL←"LNFILE.TMP";
05680 START:
05690 WHILE EOFB=0 DO BEGIN "RIPPLE"
05700 IF SNAME="END" THEN DONE;
05710 CLOSE(CHAN5); OPEN(CHAN5,"DSK",1,2,0,3500,BRK,EOFA);
05720 LOOKUP(CHAN5,FILEL,ER); WHILE ER DO BEGIN OUTSTR(CRLF&"Can't find "&FILEL&
05730 " File = "); LOOKUP(CHAN5,FILEL←INCHWL,ER); END; EOFA←0;
05740 M←8; N←2↑M; NF←2*N;
05750
05760 FILLST←INPUT(CHAN5,14); EOFA←0;
05770
05780 OUTSTR(CRLF&"Ripple learn starting with "&SNAME&" up to ");
05790 STXX←STX; SNAME←SCAN(SNAMES,1,J);
05800 OUTSTR(SNAME&CRLF);
05810 IF SNAME="" THEN DONE;
05820 FOR I←19 STEP 1 UNTIL 125 DO BEGIN
05830 IF LIST[I]=CVSIX(SNAME) THEN DONE; END;
05840 STX←I*74;
05850 OUTSTR("I="&CVS(I)&" SNAME="&CVXSTR(LIST[I])&CRLF);
05860 RL←0;
05870
05880
05890 WHILE EOFA=0 DO BEGIN "LISTREAD"
05900 HINDEX←21; HCOUNT←HINCNT←0;
05910 FILEI←SCAN(FILLST,1,J);
05920 IF FILEI="" THEN DONE;
05930
05940 CLOSE(CHAN4);
05950 OPEN(CHAN4,"DSK",'10,10,0,0,0,EOF);
05960 LOOKUP(CHAN4,FILEI,0);
05970 IF EOF≠0 THEN DONE;
05980 ARRYIN(CHAN4,LFILE[0],'200); ⊂ Input header;
05990 SEGTOT←(LFILE[0]*6)%N;
06000 OUTSTR(FILEI&" "&CVS(SEGTOT)&" seg. ");
06010 ARRYIN(CHAN4,INDATA[0],SEGTOT*4);
06020 CLOSE(CHAN4);
06030 BPT←POINT(6,INDATA[0],-1);
06040 ZZ: HINDEX←21; HCOUNT←HINCNT←0;
06050
06060 FOR SEGC←1 STEP 1 UNTIL SEGTOT DO BEGIN
06070 READ1←HEADER;
06080 J←CVSIX(READ1);
06090 FOR I←0 STEP 1 UNTIL 63 DO BEGIN IF PHLIST[I]=0 THEN BEGIN
06100 OUTSTR("Hint not identified for segment = "&READ1&" " &CVS(SEGC)&CRLF);DONE END;
06110 IF PHLIST[I]=J THEN BEGIN HINT←H←I;TABLES[2]←HLIST[I] ; DONE ; END;
06120 END;
06130
06140 FOR P←0 STEP 1 UNTIL 23 DO INDAT[P]←ILDB(BPT);
06150 ZZZZ: SIG(P);
06160 ZZZ: END;
06170
06180 OUTSTR(CVS(HINCNT)&" hints . ");
06190 IF RL=0 THEN RL←1 ELSE BEGIN RL←0; OUTSTR(CRLF); END;
06200 IF EOFA≠0 THEN DONE;
06210 END "LISTREAD";
06220 UPDATE;
06230 TABOUT;
06240 OUTSTR("Tables saved"&CRLF);
06250
06260 END "RIPPLE";
06270
06280 END "SAY";